require(GGally, quietly = TRUE)
require(reshape2, quietly = TRUE)
require(tidyverse, quietly = TRUE, warn.conflicts = FALSE)
## Loading tidyverse: ggplot2
## Loading tidyverse: tibble
## Loading tidyverse: tidyr
## Loading tidyverse: readr
## Loading tidyverse: purrr
## Loading tidyverse: dplyr
## Conflicts with tidy packages ----------------------------------------------
## filter(): dplyr, stats
## lag(): dplyr, stats
library(ggfortify)
library(cluster)
library(ggdendro)
library(broom)
library(plotly)
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(readr)
library(magrittr)
##
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
##
## set_names
## The following object is masked from 'package:tidyr':
##
## extract
theme_set(theme_bw())
Neste post vamos investigar a existência de tipos de filmes quanto ao gênero do personagem e da quantidade de palavras que ele fala. Esta investigação vai ajudar as pessoas a se confrontarem com o que se conhece popularmente a respeito de filmes voltados para o público feminino e os filmes do gênero de terror, por exemplo. Será que existem grupos que definem comportamentos comuns para os filmes analisados? Utilizaremos os dados cedidos pelo Github.
personagens = read_csv(file = "../dados/film-dialogue/character_list5.csv")
## Parsed with column specification:
## cols(
## script_id = col_integer(),
## imdb_character_name = col_character(),
## words = col_integer(),
## gender = col_character(),
## age = col_character()
## )
personagens = personagens %>%
filter(age != 'NULL') %>%
mutate(age = as.numeric(age))
filmes = read.csv(file = "../dados/film-dialogue/meta_data7.csv")
filmes = filmes %>%
filter(gross != 'NA')
filmes_personagens = merge(filmes, personagens, by="script_id")
mulheres = filmes_personagens %>%
filter(gender == 'f') %>%
group_by(script_id, imdb_id, title, year, gross) %>%
summarise(n_f=n(), words_f=median(words))
homens = filmes_personagens %>%
filter(gender == 'm') %>%
group_by(script_id, imdb_id, title, year, gross) %>%
summarise(n_m=n(), words_m=median(words))
dados = merge(mulheres, homens,
by=c('script_id','imdb_id','title','year','gross'))
duplicados = dados %>%
group_by(title) %>% filter(row_number() > 1)
dados = dados %>%
filter(!(title %in% duplicados$title))
dados = dados %>%
subset(select = -c(script_id,imdb_id,year,gross))
Observando os dados cedidos pelo repositório pude notar que o valor da variável idade, da tabela de personagens, não estava disponível ou continha valor nulo. Desta forma foi feita a filtragem dessas observações. A variável renda da tabela dos filmes tinha comportamento semelhente. Algumas observações continha valor não disponível então eu achei que seria prudente filtra-los uma vez que, filmes sem valor de renda não seriam relavantes na análise.
Uma limitação encontrada durante a análise foi o fato de alguns filmes possuirem o mesmo nome embora fossem diferentes então para submeter os dados para a análise eu tive que fazer a filtragem desses filmes com nomes repetidos também.
As dimensões submetidas a análise foram 4 variáveis numéricas calculadas a partir do conjunto de dados cedido pelo Github mencionado acima. São elas: nº de personagens do sexo feminino no filme, mediana de palavras dos personagens do sexo feminino no filme, nº de personagens do sexo masculino no filme, mediana de palavras dos personagens do sexo masculino no filme.
O conjunto de dados submetido a análise contém, para cada filme, uma observação com valores para cada variável mencionada acima. A escolha das variáveis acima visava obter a resposta para a seguinte pergunta: visando o gênero do personagem e a quantidade de palavras ditas por ele em um filme, quais os tipos de filmes?
Vamos primeiramente olhar para o gráfico abaixo, veja como se comporta a distribuição de cada dimensão dos dados.
dw = dados
dw %>%
select(-title) %>%
ggpairs(columnLabels = c("Nº mulheres",
"Palavras mulheres",
"Nº homens",
"Palavras homens"),
title = "Distribuição e correlação das dimensões")+
theme(plot.title = element_text(hjust = 0.5))
summary(select(dw, -title))
## n_f words_f n_m words_m
## Min. : 1.000 Min. : 101.0 Min. : 1.000 Min. : 114.0
## 1st Qu.: 2.000 1st Qu.: 340.6 1st Qu.: 4.000 1st Qu.: 350.0
## Median : 3.000 Median : 584.5 Median : 6.000 Median : 538.0
## Mean : 2.957 Mean : 827.3 Mean : 6.525 Mean : 759.4
## 3rd Qu.: 4.000 3rd Qu.:1017.9 3rd Qu.: 8.000 3rd Qu.: 903.0
## Max. :14.000 Max. :7664.0 Max. :23.000 Max. :5716.0
# Escala de log
dw2 <- dw %>%
mutate_each(funs(log), 2:5)
dw2 %>%
select(-title) %>%
ggpairs(columnLabels = c("Nº mulheres",
"Palavras mulheres",
"Nº homens",
"Palavras homens"),
title = "Distribuição e correlação das dimensões")+
theme(plot.title = element_text(hjust = 0.5))
summary(select(dw2, -title))
## n_f words_f n_m words_m
## Min. :0.0000 Min. :4.615 Min. :0.000 Min. :4.736
## 1st Qu.:0.6931 1st Qu.:5.831 1st Qu.:1.386 1st Qu.:5.858
## Median :1.0986 Median :6.371 Median :1.792 Median :6.288
## Mean :0.9166 Mean :6.392 Mean :1.740 Mean :6.364
## 3rd Qu.:1.3863 3rd Qu.:6.925 3rd Qu.:2.079 3rd Qu.:6.806
## Max. :2.6391 Max. :8.944 Max. :3.135 Max. :8.651
dw2.scaled = dw2 %>%
mutate_each(funs(as.vector(scale(.))), 2:5)
dw2.scaled %>%
select(-title) %>%
ggpairs(columnLabels = c("Nº mulheres",
"Palavras mulheres",
"Nº homens",
"Palavras homens"),
title = "Distribuição e correlação das dimensões")+
theme(plot.title = element_text(hjust = 0.5))
summary(select(dw2.scaled, -title))
## n_f words_f n_m words_m
## Min. :-1.5573 Min. :-2.26001 Min. :-3.14947 Min. :-2.3466
## 1st Qu.:-0.3796 1st Qu.:-0.71409 1st Qu.:-0.64030 1st Qu.:-0.7295
## Median : 0.3093 Median :-0.02742 Median : 0.09358 Median :-0.1097
## Mean : 0.0000 Mean : 0.00000 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.7981 3rd Qu.: 0.67800 3rd Qu.: 0.61428 3rd Qu.: 0.6369
## Max. : 2.9267 Max. : 3.24527 Max. : 2.52572 Max. : 3.2971
dists = dw2.scaled %>%
column_to_rownames("title") %>%
dist(method = "euclidean")
hc = hclust(dists, method = "ward.D")
n_clusters = 4
dw2 <- dw2 %>%
mutate(cluster = hc %>%
cutree(k = n_clusters) %>%
as.character())
dw2.scaled <- dw2.scaled %>%
mutate(cluster = hc %>%
cutree(k = n_clusters) %>%
as.character())
dw2.long = melt(dw2.scaled, id.vars = c("title", "cluster"))
dw2.scaled = dw2.scaled %>%
select(-cluster) # Remove o cluster adicionado antes lá em cima via hclust
# O agrupamento de fato:
km = dw2.scaled %>%
select(-title) %>%
kmeans(centers = n_clusters, nstart = 20)
# O df em formato longo, para visualização
dw2.scaled.km.long = km %>%
augment(dw2.scaled) %>% # Adiciona o resultado de km
# aos dados originais dw2.scaled em
# uma variável chamada .cluster
gather(key = "variável",
value = "valor",
-title, -.cluster) # = move para long todas as
# variávies menos repository_language
# e .cluster
dw2.scaled.km.long %>%
ggplot(aes(x = `variável`, y = valor, group = title, colour = .cluster)) +
#geom_point(alpha = 0.2) +
geom_line(alpha = .5) +
facet_wrap(~ .cluster)
autoplot(km, data = dw2.scaled, label = TRUE)
dists = dw2.scaled %>%
select(-title) %>%
dist() # só para plotar silhouetas depois
#plot(silhouette(km$cluster, dists), col = RColorBrewer::brewer.pal(n_clusters, "Set2"))
#summary(dw2.scaled)
p <- km %>%
augment(dw2.scaled) %>%
plot_ly(type = 'parcoords',
line = list(color = ~.cluster,
showScale = TRUE),
dimensions = list(
#list(range = c(1, 4), label = "cluster", values = ~cluster),
list(range = c(-3, 3),
label = 'n_f', values = ~n_f),
list(range = c(-3, 3),
label = 'words_f', values = ~words_f),
list(range = c(-6, 3),
label = 'n_m', values = ~n_m),
list(range = c(-2, 3),
label = 'words_m', values = ~words_m)
)
)
p
Qual seria um bom valor de k? Uma medida comumente usada no kmeans é comparar a distância (quadrática) entre o centro dos clusters e o centro dos dados com a distância (quadrática) entre os pontos todos nos dados e o centro dos dados. Aqui o centro dos dados é um ponto imaginário na média de todas as variáveis. Calculamos a distância do centro de cada cluster para o centro dos dados e multiplicamos pelo número de pontos nesse cluster. Somando esse valor para todos os clusters, temos betweenss abaixo. Se esse valor for próximo do somatório total das distâncias dos pontos para o centro dos dados (totss), os pontos estão próximos do centro de seu cluster. Essa proporção pode ser usada para definir um bom valor de k. Quando ela para de crescer, para de valer à pena aumentar k.
set.seed(123)
explorando_k = tibble(k = 1:15) %>%
group_by(k) %>%
do(
kmeans(select(dw2.scaled, -title),
centers = .$k,
nstart = 20) %>% glance()
)
explorando_k %>%
ggplot(aes(x = k, y = betweenss / totss)) +
geom_line() +
geom_point()